;;;
;;; Suty: String Operation Utilities
;;; 
BITS 64
;;; 
;;;  LICENSE AGREEMENT:
;;; 
;;;  You agree that we don't agree to anything.
;;; 
;;; 
;;;  DISCLAIMER OF WARRANTIES:
;;; 
;;;  This software is provided to you "AS IS," and the authors and
;;;  contributors disclaim any warranty or liability obligations to you
;;;  of any kind, implied or express, including but not limited to the
;;;  warranties of merchantability, fitness for a particular purpose,
;;;  and non-infringement.
;;; 
section .data align=16
;;; 
section .text align=16
%assign rc   0x04
%assign arg1 0x18
%assign arg2 0x20
%assign arg3 0x28
%assign arg4 0x30
%assign nt 20			;<<<<<<<<<<<<<<<<<<<<<<<<<<
;;; 
global unpack2_
global cp2d_, cle2d_
global mcps_, msets_, mcpf_, msetf_
global mkhis_
	;; global dec_
global mkhistd_
global kthsmallest_
;;; 
;;; subroutine unpack2(n,ppacked,pjxyz,pws)
;;;
;;; to be modified soon
unpack2_:
	push rbp
	mov rbp, rsp
	push rbx
	push r10
	;;
  	mov r10, rcx		; ptr ws
	;; 
	mov rcx, rdi		; 1st n
	or rcx, rcx		; if n = 0
	jz .done		;
	;; 
	mov rdi, rdx		; jx
	lea rbx, [rdi+rcx*2]	; jy
	lea r8,  [rbx+rcx*2]	; jz
 	lea r9,  [r8+rcx*2]	; w <<<
	;; 
	xor rdx, rdx		; counter
	dec rdx			;
.do
	inc rdx			;
	mov rax, [rsi+rdx*8]	; j
	;; 
	mov [rdi+rdx*2], ax	; jx
	shr rax, 16		;
	mov [rbx+rdx*2], ax	; jy
	shr rax, 16		;
	mov [r8+rdx*2], ax	; jz
	;; 
   	fld qword [r10+rdx*8]	; w in r8
   	fstp dword [r9+rdx*4]	; w in r4
	dec rcx			;
	jnz .do			;
.done  
	pop r10
	pop rbx
	pop rbp
	ret
;;;
;;; subroutine cp2d(a,b,n)
;;; real*4,intent(out)::a(n)
;;; real*4,intent(in)::b(n)
;;; integer,intent(in)::n
;;;
cp2d_:
	push rbp
	mov rbp, rsp
	;;
	mov rcx, rdx		; rcx = n
	mov rax, rcx		; rax = n
	shr rcx, 1		; rcx = n/2
	mov r8, rcx		; save n/2
	shl rcx, 1		; rcx = 2(n/2)
	sub rax, rcx		;
	mov rdx, rax		; rdx = mod(n,2)
	mov rcx, r8		; rcx = n/2
	;;
	cld			;
	rep movsq		;
	or rdx, rdx		;
	jz .exit		;
	mov rcx, rdx		;
	rep movsd		;
.exit:
	pop rbp
	ret
;;;
;;; subroutine cle2d(a,n)
;;; real*4,intent(out)::a(n)
;;; integer,intent(in)::n
;;;
cle2d_:		
	push rbp
	mov rbp, rsp
	;; 
	mov rcx, rsi		; rcx = n
	mov rax, rcx		; rax = n
	shr rcx, 1		; rcx = n/2
	mov r8, rcx		; save n/2
	shl rcx, 1		; rcx = 2(n/2)
	sub rax, rcx		;
	mov rdx, rax		; rdx = mod(n,2)
	mov rcx, r8		; rcx = n/2
	;;
	xor rax, rax		;
	cld			;
	rep stosq		;
	or rdx, rdx		;
	jz .exit		;
	mov rcx, rdx		;
	rep stosd		;
.exit:
	pop rbp
	ret
;;; 
mcpf_:
mcps_:	
	push rbp
	mov rbp, rsp
	mov rax, rdx		; n
	shr rax, 3		; n/8
	mov rcx, rax		; n/8
	shl rcx, 3		; (n/8)*8
	sub rdx, rcx		; n-(n/8)*8
	mov rcx, rax
	cld
	rep movsq
	mov rcx, rdx
	rep movsb
	pop rbp
	mov rax, rdi
	ret
;;; 
msetf_:
msets_:
	push rbp
	mov rbp, rsp
	mov rax, rdx		; n
	shr rax, 3		; n/8
	mov rcx, rax		; n/8
	shl rcx, 3		; (n/8)*8
	sub rdx, rcx		; n-(n/8)*8
	mov rcx, rax
	mov rax, rsi
	mov ah, al
	mov rsi, rax
	shl rax, 16
	or rax, rsi
	mov rsi, rax
	shl rax, 32
	or rax, rsi
	cld
	rep stosq
	mov rcx, rdx
	rep stosb
	pop rbp
	mov rax, rdi
	ret
;;; 
;;; subroutine dec(event,pd,tad1,tad2)
;;; integer*8,intent(in)::event
;;; integer*4,intent(out)::pd
;;; integer*4,intent(out)::tad1(3),tad2(3)
;;;
;;;dec_:
;;;	push rbp
;;;	mov rbp, rsp
;;;	;;
;;;	mov [rbp-arg1], rdi 	; 1st event
;;;	mov [rbp-arg2], rsi	; 2nd Pr/Del
;;;	mov [rbp-arg3], rdx	; 3rd tad1
;;;	mov [rbp-arg4], rcx	; 4th tad2
;;;	;;
;;;	mov rax, rdi		; rax=ptr event
;;;	mov rax, [rax]
;;;	;;
;;;	xor rdx, rdx
;;;	bt rax, 33		; CF=Pr/Del
;;;	adc rdx, 0		; edx=Pr/Del
;;;	mov rdi, [rbp-arg2]	; rdi=ptr pd
;;;	mov dword [rdi], edx	; pd=Pr/Del
;;;	;; 
;;;	mov dl, al		; dl=T1
;;;	mov rdi, [rbp-arg3]	; rdi= ptr tad1
;;;	mov dword [rdi], edx	; tad1(1)=T1
;;;	mov dl, ah		; dl=D1,A1
;;;	and dl, 0x3F		; dl=A1
;;;	mov dword [rdi+4], edx	; tad1(2)=A1
;;;	shr dl, 6		; dl=D1
;;;	mov dword [rdi+8], edx	; tad1(3)=D1
;;;	;; 
;;;	shr rax, 16		; 
;;;	mov dl, al		; dl=T2
;;;	mov rdi, [rbp-arg4]	; rdi= ptr tad2
;;;	mov [rdi], edx		; tad2(1)=T2
;;;	mov dl, ah		; dl=D2,A2
;;;	and dl, 0x3F		; dl=A2
;;;	mov [rdi+4], edx	; tad1(2)=A2
;;;	shr dl, 6		; dl=D2
;;;	mov [rdi+8], edx	; tad1(3)=D2
;;;	;; 
;;;.exit:	
;;;	;;
;;;	pop rbp			; 
;;;	ret

;;;
;;; subroutine mkhis(phistp,pevent,phistr,nevent)
;;; integer,intent(in),value::*
;;; integer*2 hist(128,128,128,128)
mkhis_:
	push rbp
	mov rbp, rsp
	push rbx		; save rbx
	;;
	mov [rbp-arg1], rdi 	; 1st phistp
	mov [rbp-arg2], rsi	; 2nd pevent
	mov [rbp-arg3], rdx	; 3rd phistr
	mov [rbp-arg4], rcx	; 3rd nevent
	;;
	mov rsi, [rbp-arg2]	; rcx = nevent
	mov rdi, [rbp-arg1]	; rdi = phistp
	mov rbx, [rbp-arg3]	; rbx = phistr
	mov rcx, [rbp-arg4]	; rcx = nevent
	;; 
	sub rsi, 8
	inc rcx
.do:
	dec rcx
	jbe .done
	add rsi, 8
	mov rax, [rsi]		; rax = event
	;;
	xor r9, r9		; 
	bt rax, 33		; CF=Pr/Del
	adc r9, 0		; r9=Pr/Del
	xor rdx, rdx
	
	;; get T1
	mov dl, al		; dl=T1
	sub rdx, nt		; T1=T1-20
	neg rdx
	add rdx, nt
	dec rdx			; T1=nt-T1-1
	mov r8, rdx		; r8=T1

	;; get A1
	mov dl, ah		; dl=D1,A1
	and rdx, 0x3F		; dl=A1
	shl rdx, 7		; dl=A1*128
	add r8, rdx		; r8=T1+128*A1

	;; get D1
	shr ah, 6		; ah=D1

	;; get T2
	xor rdx, rdx
	shr rax, 16		; 
	mov dl, al		; dl=T2
	sub rdx, 60		; T2=T2-60
	shl rdx, 14		; rdx=T2*128*128
	add r8, rdx		; r8=T1+128*(A1+128*T2)
	
	;; get A2
	xor rdx, rdx
	mov dl, ah		; dl=D2,A2
	and dl, 0x3F		; dl=A2
	shl rdx, 21		; rdx=A2*128*128*128
	add r8, rdx		; r8=T1+128*(A1+128*(T2+128*A2))
	
	;; get D2
	shr ah, 6		; ah=D2
	;; 
	or r9, r9
	jz .setd
	inc word [rdi+2*r8]
	jmp .do
.setd:
 	inc word [rbx+2*r8]
	jmp .do
	;; 
.done:
.exit:	
	;;
	pop rbx
	pop rbp			; 
	ret
;;; 
;;; subroutine mkhisd(event,hist,n)
;;; integer*8,intent(in)::event
;;; integer*2,intent(in)::hist
;;; integer*4,intent(in)::n
;;;
;;;mkhistd_:
;;;	push rbp
;;;	push rbx
;;;	mov rbp, rsp
;;;	push r10
;;;	
;;;	;;
;;;	mov [rbp-arg1], rdi 	; 1st event
;;;	mov [rbp-arg2], rsi	; 2nd hist
;;;	mov [rbp-arg3], rdx	; 3rd n
;;;
;;;	;;
;;;	mov rsi, [rbp-arg1]	; rsi = ptr event
;;;	mov rcx, [rbp-arg3]	; rcx = n
;;;	mov rdi, [rbp-arg2]	; rdi = ptr hist
;;;
;;;.do:
;;;	dec rcx
;;;	jl .done
;;; 	mov rax, [rsi+rcx*8]	; rax = event
;;;	mov r8, rax		; r8 = event
;;;
;;;	bt rax, 30 		; CF = LF
;;;	jnc .do			; if LF == "*1" cycle              
;;;
;;;	;;
;;;	xor rbx, rbx
;;;	bt rax, 60		; CF=Pr/Del
;;;	adc rbx, 0		; rbx = Pr/Del
;;;	shl rbx, 28     	; rbx = Pr/Del*128^4
;;;
;;;;;; Upper 32 bits
;;;	shr rax, 32		; 
;;;
;;;	mov rdx, rax		; 	
;;;	and rdx, 0x3F		; T2
;;;cmp rdx, 64
;;;jae .do
;;;	;; r9 = iy2
;;;	mov r9, rdx
;;;	
;;;	shr rax, 6		; 
;;;	mov rdx, rax
;;;	and rdx, 0x3F		; A2
;;;	mov r10, rdx		; r10 = A2
;;;cmp r10, 20
;;;jae .do
;;;	
;;;	mov rdx, rax
;;;	shr rdx, 6		;
;;;	and rdx, 0xF		; D2
;;;cmp rdx, 4
;;;jb .do
;;;cmp rdx, 7
;;;ja .do
;;;	
;;;	;;  rdx = (D2-4)*20+A2 = ix2
;;;	sub rdx, 4
;;;	lea rdx, [rdx+rdx*4]
;;;	shl rdx, 2
;;;	add rdx, r10
;;;
;;;	;; r9 = iy2*128+ix2
;;;	shl r9, 7
;;;	add r9, rdx
;;;
;;;;;; Lower 32 bits
;;;	mov rax, r8		; event
;;;	mov rdx, rax		; 
;;;	and rdx, 0x3F		; rdx = T1
;;;cmp rdx, 64
;;;jae .do
;;;	;; r9 = (iy2*128+ix2)*128+iy1
;;;	shl r9, 7
;;;	add r9, rdx
;;;
;;;	shr rax, 6		; 
;;;	mov rdx, rax
;;;	and rdx, 0x3F		; rdx = A1
;;;cmp rdx, 20
;;;jae .do
;;;	mov r10, rdx		; r10 = A1
;;;	
;;;	shr rax, 6
;;;	mov rdx, rax		;
;;; 	and rdx, 0xF		; rdx = D1
;;;cmp rdx, 3
;;;ja .do
;;;	
;;;	;; rdx = D1*20
;;;	lea rdx, [rdx+rdx*4]
;;;	shl rdx, 2
;;;
;;;	;; rax = D1*20+19-A1 = ix1
;;;	neg r10
;;;	add r10, 19
;;;	add rdx, r10
;;;
;;;	;; r9 = ((iy2*128+ix2)*128+iy1)*128+ix1
;;;	shl r9, 7
;;;	add r9, rdx
;;;
;;;	;; 
;;;	add r9, rbx
;;;  	inc word [rdi+r9*2]
;;;jmp .do
;;;	;; 
;;;.done:
;;;.exit:	
;;;	;;
;;;	pop r10
;;;	pop rbx
;;;	pop rbp			; 
;;;	ret
;;;	
;;; subroutine kthsmallest(a,n,k)
;;; real*8,intent(inout)::a(n)
;;; integer,intent(in)::n
;;; integer,intent(in)::k	
%macro swap 2
	push %1
	push %2
	pop %1
	pop %2
%endm
%assign wsz 4
kthsmallest_:
	push rbp
	mov rbp, rsp
	;;
	xor r9, r9		; =l
	mov r8, rsi		;
	dec r8			; =m=n-1
	dec rdx			; = k
	;; 
.main:
	cmp r9, r8
	jge .done
	
	mov rsi, [rdi+wsz*rdx]	; rsi= x = a(k)
	mov rax, r9		; =i
	mov rcx, r8		; =j=m
.do1:
	cmp rsi, [rdi+wsz*rax]	; x > a(i)
	jle .do2
	inc rax
	jmp .do1
.do2:
	cmp rsi, [rdi+wsz*rcx]	; x < a(j)
	jge .next1
	dec rcx
	jmp .do2
.next1:
	cmp rax, rcx		; i <= j
	jg .next4
.next2:
	je .next3
	swap qword [rdi+wsz*rax], qword [rdi+wsz*rcx]
.next3:
	inc rax
	dec rcx
	cmp rax, rcx		; i <= j
	jle .do1
.next4:
	cmp rcx, rdx		; j < k
	jge .sub1
	mov r9, rax 		; l = i
.sub1:
	cmp rdx, rax		; k < i
	jge .sub2
	mov r8, rcx 		; m = j
.sub2:
	jmp .main
.done:
.exit:
	pop rbp
	ret
;;; 
